perm filename CLTCOM.LSP[E80,JMC] blob
sn#534934 filedate 1980-09-15 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 examples for compiling from multiple output form to LISP
C00004 ENDMK
Cā;
;;; examples for compiling from multiple output form to LISP
(defun substc (x y z n)
(cond
((atom z) n (cond ((= z y) x) (t z)))
(t ((lambda (n1 w1)
((lambda (n2 w2) n2 (cons w1 w2))
(substc x y (cdr z) n1)))
(substc x y (car z) (add1 n))))))
;;; The previous function expands (without optimization) to
(defun substc1 (w)
(cond
((atom (nth 2 w))
(append
(list (nth 3 w))
(cond
((eq (nth 2 w) (nth 1 w)) (list (nth 0 w)))
(t (list (nth 2 w))))))
(t ((lambda (w1)
((lambda (w2)
(append
(list (nth 0 w2))
(list (cons (nth 1 w1) (nth 1 w2)))))
(substc1 (append
(list (nth 0 w))
(list (nth 1 w))
(list (cdr (nth 2 w)))
(list (nth 0 w1))))))
(substc1 (append
(list (nth 0 w))
(list (nth 1 w))
(list (car (nth 2 w)))
(list (add1 (nth 3 w)))))))))
;;; program to translate multi-output programs to single output programs
(defun ccom (f g) (putprop g (ccom1 f g (get f 'expr)) 'expr))